home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 May / CMCD0504.ISO / Software / Freeware / Programare / dspack / DSPACK231.exe / {app} / Demos / DSVideoWinDowEx / PlayWin / Unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2002-12-21  |  14.4 KB  |  509 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, DSPack, DirectShow9, StdCtrls, ActiveX, DSUtil, Menus,
  8.   ExtCtrls, ComCtrls, Buttons, ImgList;
  9.  
  10. type
  11.   pPlayListItem = ^TPlayListItem;
  12.   TPlayListItem = Record
  13.     Filename : String;
  14.     Path : String;
  15.   End;
  16.  
  17.   TForm1 = class(TForm)
  18.     FilterGraph1: TFilterGraph;
  19.     OpenDialog1: TOpenDialog;
  20.     MainMenu1: TMainMenu;
  21.     File1: TMenuItem;
  22.     Open1: TMenuItem;
  23.     Exit1: TMenuItem;
  24.     Panel1: TPanel;
  25.     TrackBar1: TTrackBar;
  26.     SpeedButton1: TSpeedButton;
  27.     SpeedButton2: TSpeedButton;
  28.     SpeedButton3: TSpeedButton;
  29.     ImageList1: TImageList;
  30.     SpeedButton4: TSpeedButton;
  31.     SpeedButton5: TSpeedButton;
  32.     Label1: TLabel;
  33.     PopupMenu1: TPopupMenu;
  34.     Play1: TMenuItem;
  35.     Pause1: TMenuItem;
  36.     Stop1: TMenuItem;
  37.     N1: TMenuItem;
  38.     Fullscreen1: TMenuItem;
  39.     Panel3: TPanel;
  40.     ColorControl1: TMenuItem;
  41.     N2: TMenuItem;
  42.     SoundLevel: TTrackBar;
  43.     Label3: TLabel;
  44.     ImageList2: TImageList;
  45.     DSVideoWindowEx1: TDSVideoWindowEx2;
  46.     Panel2: TPanel;
  47.     Splitter1: TSplitter;
  48.     PopupMenu2: TPopupMenu;
  49.     Add1: TMenuItem;
  50.     Remove1: TMenuItem;
  51.     Clear1: TMenuItem;
  52.     View1: TMenuItem;
  53.     AspectRatio1: TMenuItem;
  54.     Stretched1: TMenuItem;
  55.     LetterBox1: TMenuItem;
  56.     Crop1: TMenuItem;
  57.     SpeedButton6: TSpeedButton;
  58.     SpeedButton7: TSpeedButton;
  59.     Panel4: TPanel;
  60.     ListBox1: TListBox;
  61.     SpeedButton13: TSpeedButton;
  62.     N3: TMenuItem;
  63.     Exit2: TMenuItem;
  64.     ComboBox1: TComboBox;
  65.     Memo1: TMemo;
  66.     DSTrackBar1: TDSTrackBar;
  67.     Label2: TLabel;
  68.     Bevel1: TBevel;
  69.     procedure Open1Click(Sender: TObject);
  70.     procedure Exit1Click(Sender: TObject);
  71.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  72.     procedure DSVideoWindowEx1ColorKeyChanged(Sender: TObject);
  73.     procedure TrackBar1Change(Sender: TObject);
  74.     procedure SpeedButton1Click(Sender: TObject);
  75.     procedure SpeedButton2Click(Sender: TObject);
  76.     procedure SpeedButton3Click(Sender: TObject);
  77.     procedure FormCreate(Sender: TObject);
  78.     procedure SpeedButton4Click(Sender: TObject);
  79.     procedure SpeedButton5Click(Sender: TObject);
  80.     procedure DSTrackBar1Timer(sender: TObject; CurrentPos,
  81.       StopPos: Cardinal);
  82.     procedure SoundLevelChange(Sender: TObject);
  83.     procedure CheckColorControlSupport;
  84.     procedure PopupMenu2Popup(Sender: TObject);
  85.     procedure Add1Click(Sender: TObject);
  86.     procedure ListBox1DblClick(Sender: TObject);
  87.     procedure PlayFile(Filename : String);
  88.     procedure FilterGraph1GraphComplete(sender: TObject; Result: HRESULT;
  89.       Renderer: IBaseFilter);
  90.     procedure Stretched1Click(Sender: TObject);
  91.     procedure LetterBox1Click(Sender: TObject);
  92.     procedure Crop1Click(Sender: TObject);
  93.     procedure SpeedButton13Click(Sender: TObject);
  94.     procedure PopupMenu1Popup(Sender: TObject);
  95.     procedure SpeedButton7Click(Sender: TObject);
  96.     procedure SpeedButton6Click(Sender: TObject);
  97.     procedure Clear1Click(Sender: TObject);
  98.     procedure Exit2Click(Sender: TObject);
  99.     procedure FilterGraph1DSEvent(sender: TComponent; Event, Param1,
  100.       Param2: Integer);
  101.     procedure DSVideoWindowEx1OverlayVisible(Sender: TObject;
  102.       Visible: Boolean);
  103.   private
  104.     { Private declarations }
  105.   public
  106.     { Public declarations }
  107.     OsdChanged : Boolean;
  108.     PlayListItem : pPlayListItem;
  109.     PlayingIndex : Integer;
  110.   end;
  111.  
  112. var
  113.   Form1: TForm1;
  114.  
  115. implementation
  116.  
  117. uses ColorControl;
  118.  
  119. {$R *.dfm}
  120.  
  121. procedure TForm1.Open1Click(Sender: TObject);
  122. var
  123.   i : Integer;
  124. begin
  125.   // The Add file to playerlist was selected.
  126.   If OpenDialog1.Execute then
  127.   Begin
  128.     Listbox1.Items.Clear;
  129.     with OpenDialog1.Files do
  130.       // Now go thru every files selected in the opendialog and add
  131.       // them one by one to the Players playlist.
  132.       // The first file added to the players playlist will loaded
  133.       // automaticly
  134.       for I := Count - 1 downto 0 do
  135.       begin
  136.         New(PlayListItem);
  137.         PlayListItem^.Filename := ExtractFilename(Strings[I]);
  138.         PlayListItem^.Path := ExtractFilePath(Strings[I]);
  139.         ListBox1.Items.AddObject(PlayListItem^.Filename, TObject(PlayListItem));
  140.       end;
  141.     Listbox1.ItemIndex := 0;
  142.     PlayFile(OpenDialog1.Files.Strings[0]);
  143.     PlayingIndex := 0;
  144.   end;
  145.   if PlayingIndex < Listbox1.Items.Count -1 then
  146.     SpeedButton7.Enabled := True;
  147. end;
  148.  
  149. procedure TForm1.Exit1Click(Sender: TObject);
  150. begin
  151.   FilterGraph1.ClearGraph;
  152. {  FilterGraph1.Active := false;
  153.   Application.Terminate;}
  154. end;
  155.  
  156. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  157. begin
  158.   Exit1Click(nil)
  159. end;
  160.  
  161. procedure TForm1.DSVideoWindowEx1ColorKeyChanged(Sender: TObject);
  162. begin
  163.   If DSVideoWindowEx1.OverlayVisible then
  164.   Begin
  165.     Panel2.Color := DSVideoWindowEx1.ColorKey;
  166.     ImageList2.BkColor := DSVideoWindowEx1.ColorKey;
  167.   end
  168.   else
  169.   Begin
  170.     Panel2.Color := DSVideoWindowEx1.Color;
  171.     ImageList2.BkColor := DSVideoWindowEx1.Color;
  172.   end;
  173. end;
  174.  
  175. procedure TForm1.TrackBar1Change(Sender: TObject);
  176. begin
  177.   DSVideoWindowEx1.DigitalZoom := TrackBar1.Position;
  178. end;
  179.  
  180. procedure TForm1.SpeedButton1Click(Sender: TObject);
  181. begin
  182.   if not FilterGraph1.Active then
  183.     Open1Click(nil)
  184.   else
  185.     FilterGraph1.play;
  186.   CheckColorControlSupport;
  187. end;
  188.  
  189. procedure TForm1.SpeedButton2Click(Sender: TObject);
  190. begin
  191.   FilterGraph1.Pause;
  192. end;
  193.  
  194. procedure TForm1.SpeedButton3Click(Sender: TObject);
  195. begin
  196.   FilterGraph1.Stop;
  197. end;
  198.  
  199. procedure TForm1.FormCreate(Sender: TObject);
  200. var
  201.   i : Integer;
  202. begin
  203.   Imagelist1.GetBitmap(3, SpeedButton1.Glyph);
  204.   Imagelist1.GetBitmap(2, SpeedButton2.Glyph);
  205.   Imagelist1.GetBitmap(4, SpeedButton3.Glyph);
  206.   Imagelist1.GetBitmap(9, SpeedButton4.Glyph);
  207.   Imagelist1.GetBitmap(8, SpeedButton13.Glyph);
  208.   Imagelist1.GetBitmap(0, SpeedButton6.Glyph);
  209.   Imagelist1.GetBitmap(6, SpeedButton7.Glyph);
  210.  
  211.   Case DSVideoWindowEx1.AspectRatio of
  212.     rmStretched : Stretched1.Checked := True;
  213.     rmLetterBox : LetterBox1.Checked := True;
  214.     rmCrop      : Crop1.Checked := True;
  215.   End;
  216.   Combobox1.Items.Add('Current Monitor');
  217.   If Screen.MonitorCount > 1 then
  218.   Begin
  219.     for I := 0 to Screen.MonitorCount - 1 do
  220.       Combobox1.Items.Add('Monitor'+inttostr(I));
  221.     Combobox1.Enabled := True;
  222.   End;
  223.   Combobox1.ItemIndex := 0;
  224. end;
  225.  
  226. procedure TForm1.SpeedButton4Click(Sender: TObject);
  227. begin
  228.   If DSVideoWindowEx1.FullScreen then
  229.     DSVideoWindowEx1.NormalPlayback
  230.   else
  231.     If Combobox1.ItemIndex > 0 then
  232.       DSVideoWindowEx1.StartFullScreen(Screen.Monitors[Combobox1.Itemindex -1])
  233.     else
  234.       DSVideoWindowEx1.StartFullScreen;
  235.   SpeedButton4.Down := DSVideoWindowEx1.FullScreen;
  236. end;
  237.  
  238. procedure TForm1.SpeedButton5Click(Sender: TObject);
  239. begin
  240.   ColorControlForm.Show;
  241. end;
  242.  
  243. procedure TForm1.DSTrackBar1Timer(sender: TObject; CurrentPos,
  244.   StopPos: Cardinal);
  245. var
  246.   CurrPos : Int64;
  247.   Value, H, M, S : Integer;
  248.   MediaSeeking: IMediaSeeking;
  249. begin
  250.   FilterGraph1.QueryInterface(IMediaSeeking, MediaSeeking);
  251.   with MediaSeeking do
  252.   Begin
  253.     GetCurrentPosition(CurrPos);
  254.     Value := Trunc(CurrPos / 10000000);
  255.     H := value div 3600;
  256.     M := (value mod 3600) div 60;
  257.     S := (value mod 3600) mod 60;
  258.     Panel2.Caption := Format('%d:%2.2d:%2.2d', [H, M, S]);
  259.   End;
  260.   If OsdChanged then
  261.   Begin
  262.     DSVideoWindowEx1.ClearBack;
  263.     OsdChanged := False;
  264.   End;
  265. end;
  266.  
  267. procedure TForm1.SoundLevelChange(Sender: TObject);
  268. var
  269.   Tmp : TBitmap;
  270. begin
  271.   Tmp := TBitmap.Create;
  272.   Imagelist2.GetBitmap(0, Tmp);
  273.   FilterGraph1.Volume := SoundLevel.Position;
  274.   DSVideoWindowEx1.Canvas.CopyRect(Rect(10, DSVideoWindowEx1.Height - 65, 218, DSVideoWindowEx1.Height - 27), Tmp.Canvas, Rect(0, 0, 104, 23));
  275.   Imagelist2.GetBitmap(1, Tmp);
  276.   DSVideoWindowEx1.Canvas.CopyRect(Rect(10, DSVideoWindowEx1.Height - 65, 10 + Trunc((104 / 10000) * SoundLevel.Position) * 2, DSVideoWindowEx1.Height - 27), Tmp.Canvas, Rect(0,0,Trunc((104 / 10000) * SoundLevel.Position), 23));
  277.   Tmp.Free;
  278.   OsdChanged := True;
  279. end;
  280.  
  281. procedure TForm1.CheckColorControlSupport;
  282. Begin
  283.   SpeedButton5.Enabled := True;
  284.   ColorControl1.Enabled := True;
  285. End;
  286.  
  287. procedure TForm1.PopupMenu2Popup(Sender: TObject);
  288. begin
  289.   If Listbox1.ItemIndex <> -1 then
  290.     Remove1.Enabled := True
  291.   else
  292.     Remove1.Enabled := False;
  293.   If Listbox1.Items.Count > 0 then
  294.     Clear1.Enabled := True
  295.   else
  296.     Clear1.Enabled := False;
  297. end;
  298.  
  299. procedure TForm1.Add1Click(Sender: TObject);
  300. var
  301.   i : Integer;
  302. begin
  303.   If ListBox1.Items.Count < 1 then
  304.   Begin
  305.     Open1Click(nil);
  306.     SpeedButton6.Enabled := False;
  307.     SpeedButton7.Enabled := False;
  308.     Exit;
  309.   End;
  310.   if OpenDialog1.Execute then
  311.   begin
  312.     with OpenDialog1.Files do
  313.       // Now go thru every files selected in the opendialog and add
  314.       // them one by one to the Players playlist.
  315.       // The first file added to the players playlist will loaded
  316.       // automaticly
  317.       for I := Count - 1 downto 0 do
  318.       begin
  319.         New(PlayListItem);
  320.         PlayListItem^.Filename := ExtractFilename(Strings[I]);
  321.         PlayListItem^.Path := ExtractFilePath(Strings[I]);
  322.         ListBox1.Items.AddObject(PlayListItem^.Filename, TObject(PlayListItem));
  323.       end;
  324.   End;
  325.   If PlayingIndex > 0 then
  326.     SpeedButton6.Enabled := True;
  327.   if PlayingIndex < Listbox1.Items.Count -1 then
  328.     SpeedButton7.Enabled := True;
  329. end;
  330.  
  331. procedure TForm1.ListBox1DblClick(Sender: TObject);
  332. var
  333.   Filename : String;
  334. begin
  335.   If ListBox1.ItemIndex = PlayingIndex then Exit;
  336.   PlayListItem := pPlayListitem(Listbox1.Items.Objects[ListBox1.Itemindex]);
  337.   Filename := PlayListItem^.Path;
  338.   If Filename[Length(Filename)] <> '\' then
  339.     Filename := Filename + '\';
  340.   Filename := Filename + PlayListItem^.Filename;
  341.   PlayFile(Filename);
  342.   PlayingIndex := Listbox1.Itemindex;
  343.   If PlayingIndex > 0 then
  344.     SpeedButton6.Enabled := True
  345.   else
  346.     SpeedButton6.Enabled := False;
  347.   if PlayingIndex < Listbox1.Items.Count -1 then
  348.     SpeedButton7.Enabled := True
  349.   else
  350.     SpeedButton7.Enabled := False;
  351. end;
  352.  
  353. procedure TForm1.PlayFile(Filename : String);
  354. Begin
  355.   FilterGraph1.ClearGraph;
  356.  
  357.   // --------------------------------------------------------------------------------------
  358.   // This is a workaround the problem that we don't always get the EC_CLOCK_CHANGED.
  359.   // and because we didn't get the EC_CLOCK_CHANGED the DSTrackbar and DSVideoWindowEx1
  360.   // didn't got reassigned and that returned in misfuntions.
  361.   FilterGraph1.Active := False;
  362.   FilterGraph1.Active := True;
  363.   // --------------------------------------------------------------------------------------
  364.  
  365.   FilterGraph1.RenderFile(FileName);
  366.   SoundLevel.Position := FilterGraph1.Volume;
  367.   FilterGraph1.Play;
  368.   CheckColorControlSupport;
  369. End;
  370.  
  371. procedure TForm1.FilterGraph1GraphComplete(sender: TObject;
  372.   Result: HRESULT; Renderer: IBaseFilter);
  373. Var
  374.   Filename : String;
  375. begin
  376.   If Playingindex < Listbox1.Items.Count -1 then
  377.   Begin
  378.     Listbox1.ItemIndex := ListBox1.ItemIndex +1;
  379.     PlayListItem := pPlayListItem(Listbox1.Items.Objects[Listbox1.ItemIndex]);
  380.     Filename := PlayListItem^.Path;
  381.     If Filename[Length(Filename)] <> '\' then
  382.       Filename := Filename + '\';
  383.     Filename := Filename + PlayListItem^.Filename;
  384.     PlayFile(Filename);
  385.     PlayingIndex := Listbox1.Itemindex;
  386.   End;
  387.   If PlayingIndex > 0 then
  388.     SpeedButton6.Enabled := True
  389.   else
  390.     SpeedButton6.Enabled := False;
  391.   if PlayingIndex < Listbox1.Items.Count -1 then
  392.     SpeedButton7.Enabled := True
  393.   else
  394.     SpeedButton7.Enabled := False;
  395. end;
  396.  
  397. procedure TForm1.Stretched1Click(Sender: TObject);
  398. begin
  399.   DSVideoWindowEx1.AspectRatio := rmStretched;
  400. end;
  401.  
  402. procedure TForm1.LetterBox1Click(Sender: TObject);
  403. begin
  404.   DSVideoWindowEx1.AspectRatio := rmLetterBox;
  405. end;
  406.  
  407. procedure TForm1.Crop1Click(Sender: TObject);
  408. begin
  409.   DSVideoWindowEx1.AspectRatio := rmCrop;
  410. end;
  411.  
  412. procedure TForm1.SpeedButton13Click(Sender: TObject);
  413. begin
  414.   If Not DSVideoWindowEx1.DesktopPlayback then
  415.   Begin
  416.     If Combobox1.ItemIndex > 0 then
  417.       DSVideoWindowEx1.StartDesktopPlayback(Screen.Monitors[Combobox1.Itemindex -1])
  418.     else
  419.       DSVideoWindowEx1.StartDesktopPlayback;
  420.   End
  421.   else
  422.     DSVideoWindowEx1.NormalPlayback;
  423. end;
  424.  
  425. procedure TForm1.PopupMenu1Popup(Sender: TObject);
  426. begin
  427.   FullScreen1.Checked := DSVideoWindowEx1.FullScreen;
  428. end;
  429.  
  430. procedure TForm1.SpeedButton7Click(Sender: TObject);
  431. Var
  432.   Filename : String;
  433. begin
  434.   If Playingindex < Listbox1.Items.Count -1 then
  435.   Begin
  436.     Listbox1.ItemIndex := ListBox1.ItemIndex +1;
  437.     PlayListItem := pPlayListItem(Listbox1.Items.Objects[Listbox1.ItemIndex]);
  438.     Filename := PlayListItem^.Path;
  439.     If Filename[Length(Filename)] <> '\' then
  440.       Filename := Filename + '\';
  441.     Filename := Filename + PlayListItem^.Filename;
  442.     PlayFile(Filename);
  443.     PlayingIndex := Listbox1.Itemindex;
  444.   End;
  445.   If PlayingIndex > 0 then
  446.     SpeedButton6.Enabled := True
  447.   else
  448.     SpeedButton6.Enabled := False;
  449.   if PlayingIndex < Listbox1.Items.Count -1 then
  450.     SpeedButton7.Enabled := True
  451.   else
  452.     SpeedButton7.Enabled := False;
  453. end;
  454.  
  455. procedure TForm1.SpeedButton6Click(Sender: TObject);
  456. Var
  457.   Filename : String;
  458. begin
  459.   If Playingindex > 0 then
  460.   Begin
  461.     Listbox1.ItemIndex := ListBox1.ItemIndex -1;
  462.     PlayListItem := pPlayListItem(Listbox1.Items.Objects[Listbox1.ItemIndex]);
  463.     Filename := PlayListItem^.Path;
  464.     If Filename[Length(Filename)] <> '\' then
  465.       Filename := Filename + '\';
  466.     Filename := Filename + PlayListItem^.Filename;
  467.     PlayFile(Filename);
  468.     PlayingIndex := Listbox1.Itemindex;
  469.   End;
  470.   If PlayingIndex > 0 then
  471.     SpeedButton6.Enabled := True
  472.   else
  473.     SpeedButton6.Enabled := False;
  474.   if PlayingIndex < Listbox1.Items.Count -1 then
  475.     SpeedButton7.Enabled := True
  476.   else
  477.     SpeedButton7.Enabled := False;
  478. end;
  479.  
  480. procedure TForm1.Clear1Click(Sender: TObject);
  481. begin
  482.   FilterGraph1.Stop;
  483.   FilterGraph1.ClearGraph;
  484.   FilterGraph1.Active := False;
  485.   Listbox1.Items.Clear;
  486. end;
  487.  
  488. procedure TForm1.Exit2Click(Sender: TObject);
  489. begin
  490.   Close;
  491. end;
  492.  
  493. procedure TForm1.FilterGraph1DSEvent(sender: TComponent; Event, Param1,
  494.   Param2: Integer);
  495. begin
  496.   Memo1.Lines.Add(GetEventCodeDef(event));
  497. end;
  498.  
  499. procedure TForm1.DSVideoWindowEx1OverlayVisible(Sender: TObject;
  500.   Visible: Boolean);
  501. begin
  502.   If Visible then
  503.     Panel2.Color := DSVideoWindowEx1.ColorKey
  504.   else
  505.     Panel2.Color := DSVideoWindowEx1.Color;
  506. end;
  507.  
  508. end.
  509.